home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / EXEC2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-05-19  |  7KB  |  206 lines
  1.  
  2. { EXEC.PAS version 1.3
  3.  
  4.   This file contains 2 functions for Turbo Pascal that allow you to run other
  5.   programs from within a Turbo program.  The first function, SubProcess,
  6.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  7.   second function, GetComSpec, returns the path name of the command
  8.   interpreter, which is necessary to do certain operations.  There is also a
  9.   main program that allows you to test the functions.
  10.  
  11.   Revision history
  12.   ----------------
  13.   Version 1.3 works with MS-DOS 2.0 and up, TURBO PASCAL version 1.0 and up.
  14.   Version 1.2 had a subtle but dangerous bug: I set a variable that was
  15.               addressed relative to BP, using a destroyed BP!
  16.   Version 1.1 didn't work with Turbo 2.0 because I used Turbo 3.0 features
  17.   Version 1.0 only worked with DOS 3.0 due to a subtle bug in DOS 2.x
  18.  
  19.     -  Bela Lubkin
  20.        Borland International Technical Support
  21.        CompuServe 71016,1573
  22. }
  23.  
  24. Type
  25.   Str66=String[66];
  26.   Str255=String[255];
  27.  
  28. Function SubProcess(CommandLine: Str255): Integer;
  29.   { Pass this function a string of the form
  30.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  31.  
  32.     For example,
  33.       'C:\SYSTEM\CHKDSK.COM'
  34.       'A:\WS.COM DOCUMENT.1'
  35.       'C:\DOS\LINK.EXE TEST;'
  36.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  37.  
  38.     The third example shows several things.  To do any of the following, you
  39.     must invoke the command processor and let it do the work: redirection;
  40.     piping; path searching; searching for the extension of a program (.COM,
  41.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  42.     command processor file is stored in the DOS environment.  The function
  43.     GetComSpec in this file returns the path name of the command processor.
  44.     Also note that you must use the /C parameter or COMMAND will not work
  45.     correctly.  You can also call COMMAND with no parameters.  This will allow
  46.     the user to use the DOS prompt to run anything (as long as there is enough
  47.     memory).  To get back to your program, he can type the command EXIT.
  48.  
  49.     Actual example:
  50.       I:=SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  51.  
  52.     The value returned is the result returned by DOS after the EXEC call.  The
  53.     most common values are:
  54.  
  55.        0: Success
  56.        1: Invalid function (should never happen with this routine)
  57.        2: File/path not found
  58.        8: Not enough memory to load program
  59.       10: Bad environment (greater than 32K)
  60.       11: Illegal .EXE file format
  61.  
  62.     If you get any other result, consult an MS-DOS Technical Reference manual.
  63.  
  64.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  65.     restrict the amount of free dynamic memory used by your program.  Only the
  66.     memory that is not used by the heap is available for use by other
  67.     programs. }
  68.  
  69.   Const
  70.     SSSave: Integer=0;
  71.     SPSave: Integer=0;
  72.  
  73.   Var
  74.     Regs: Record Case Integer Of
  75.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  76.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  77.           End;
  78.     FCB1,FCB2: Array [0..36] Of Byte;
  79.     PathName: Str66;
  80.     CommandTail: Str255;
  81.     ParmTable: Record
  82.                  EnvSeg: Integer;
  83.                  ComLin: ^Integer;
  84.                  FCB1Pr: ^Integer;
  85.                  FCB2Pr: ^Integer;
  86.                End;
  87.     I,RegsFlags: Integer;
  88.  
  89.   Begin
  90.     If Pos(' ',CommandLine)=0 Then
  91.      Begin
  92.       PathName:=CommandLine+#0;
  93.       CommandTail:=^M;
  94.      End
  95.     Else
  96.      Begin
  97.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  98.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  99.      End;
  100.     CommandTail[0]:=Pred(CommandTail[0]);
  101.     With Regs Do
  102.      Begin
  103.       FillChar(FCB1,Sizeof(FCB1),0);
  104.       AX:=$2901;
  105.       DS:=Seg(CommandTail[1]);
  106.       SI:=Ofs(CommandTail[1]);
  107.       ES:=Seg(FCB1);
  108.       DI:=Ofs(FCB1);
  109.       MsDos(Regs); { Create FCB 1 }
  110.       FillChar(FCB2,Sizeof(FCB2),0);
  111.       AX:=$2901;
  112.       ES:=Seg(FCB2);
  113.       DI:=Ofs(FCB2);
  114.       MsDos(Regs); { Create FCB 2 }
  115.       ES:=CSeg;
  116.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  117.       AH:=$4A;
  118.       MsDos(Regs); { Deallocate unused memory }
  119.       With ParmTable Do
  120.        Begin
  121.         EnvSeg:=MemW[CSeg:$002C];
  122.         ComLin:=Addr(CommandTail);
  123.         FCB1Pr:=Addr(FCB1);
  124.         FCB2Pr:=Addr(FCB2);
  125.        End;
  126.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  127.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  128.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  129.              $1E/$55/                 { Save <DS>, <BP>         }
  130.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  131.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  132.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  133.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  134.              $FA/                     { Disable interrupts      }
  135.              $CD/$21/                 { Call MS-DOS             }
  136.              $FA/                     { Disable interrupts      }
  137.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  138.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  139.              $FB/                     { Enable interrupts       }
  140.              $5D/$1F/                 { Restore <BP>,<DS>       }
  141.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  142.              $89/$86/ Regs );         { Regs.AX:=<AX>;          }
  143.       { The messing around with SS and SP is necessary because under DOS 2.x,
  144.         after returning from an EXEC call, ALL registers are destroyed except
  145.         CS and IP!  I wish I'd known that before I released this package the
  146.         first time... }
  147.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  148.       Else SubProcess:=0;
  149.      End;
  150.   End;
  151.  
  152. Function GetComSpec: Str66;
  153.   Type
  154.     Env=Array [0..32767] Of Char;
  155.   Var
  156.     EPtr: ^Env;
  157.     EStr: Str255;
  158.     Done: Boolean;
  159.     I: Integer;
  160.  
  161.   Begin
  162.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  163.     I:=0;
  164.     Done:=False;
  165.     EStr:='';
  166.     Repeat
  167.       If EPtr^[I]=#0 Then
  168.        Begin
  169.         If EPtr^[I+1]=#0 Then Done:=True;
  170.         If Copy(EStr,1,8)='COMSPEC=' Then
  171.          Begin
  172.           GetComSpec:=Copy(EStr,9,100);
  173.           Done:=True;
  174.          End;
  175.         EStr:='';
  176.        End
  177.       Else EStr:=EStr+EPtr^[I];
  178.       I:=I+1;
  179.     Until Done;
  180.   End;
  181.  
  182. { Example program.  Set both mInimum and mAximum free dynamic memory to 100
  183.   and compile this to a .COM file.  Delete the next line to enable: }
  184. (*
  185.  
  186. Var Command: Str255;
  187.     I: Integer;
  188.  
  189. Begin
  190.   WriteLn('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  191.   Repeat
  192.     Write('=->');
  193.     ReadLn(Command);
  194.     If Command='*' Then Halt;
  195.     If Command<>'' Then
  196.      Begin
  197.       If Command[1]='*' Then Command:=GetComSpec+' /C '+Copy(Command,2,255);
  198.       I:=SubProcess(Command);
  199.       If I<>0 Then WriteLn('Error - ',I);
  200.      End;
  201.   Until False;
  202. End.
  203. *)
  204.  
  205.  
  206.